home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 051-075 / disk_075 / dum2 / src / dutypefi.mod < prev    next >
Text File  |  1992-05-06  |  7KB  |  271 lines
  1. IMPLEMENTATION MODULE DuTypefile;
  2.  
  3. (*$S-*)(*$T-*)(*$A+*)
  4.  
  5. (*
  6.      Written by Greg Browne from ideas in duIII.c - many thanks to
  7.      Chris Nicotra, Dave Jobusch, Ed Alford, and many others whose
  8.      names I have not seen on the source files who have worked on
  9.      the development and extension of that fine directory utility program.
  10.  
  11.    PURPOSE      A self-contained, IMPORTable pair of procedures to allow
  12.                 a screen display - or printer copy - in Hex or ASCII of
  13.                 any disk files.
  14.  
  15.    CHANGES      1/24/87         Built original.
  16.  
  17. *)
  18.  
  19. FROM SYSTEM             IMPORT  ADR;
  20. FROM Strings            IMPORT  String,InitStringModule,Concat,Assign;
  21. FROM DOSFiles           IMPORT  FileHandle,ModeOldFile,ModeNewFile,Close,
  22.                                 Open,Read,Write,Lock,Unlock,AccessRead,
  23.                                 FileLock;
  24. FROM DOSLibrary         IMPORT  DOSName,DOSBase;
  25. FROM Libraries          IMPORT  OpenLibrary,CloseLibrary;
  26.  
  27. (*COMMENTS*)
  28.  
  29. (* This module tries to open the DOSLibrary for use in case it is not open.
  30.    IT DOES NOT CLOSE IT.  The user is left with that chore.             *)
  31.  
  32. (* All constants and variables are internal.  Nothing but PROCEDURES
  33.    are available to the user.                                           *)
  34.  
  35. CONST
  36.  lf = 12C;
  37.  dot = ".";
  38.  cr = 15C;
  39.   expl = "q[33m<CR>q[2m = next line - q[33m<SPACE>q[2m = next page - q[33m<ESC>q[2m = abortq[0m";
  40.   wipe  = "x                                                                           x";
  41.   last ="q[33mEnd of File.  Press SPACE q[0m";
  42.  
  43. VAR
  44.   HexCh         : ARRAY [0..16] OF CHAR;
  45.   Disk,
  46.   Display       : FileHandle;
  47.   fp1,fp2,
  48.   fp3,fp4       : CARDINAL;
  49.   c             : CHAR;
  50.   len,len2,
  51.   i,
  52.   top,
  53.   linecount,
  54.   nextout       : CARDINAL;
  55.   Result        : LONGINT;
  56.   DiskERR,
  57.   PastEOF,
  58.   KeepWaiting,
  59.   OnScreen,
  60.   Quit  : BOOLEAN;
  61.   command       : ARRAY[0..79] OF CHAR;
  62.   writebuffer   : ARRAY[0..80] OF CHAR;
  63.   t2            : ARRAY[1..20] OF CHAR;
  64.   inbuffer      : ARRAY[0..512] OF CHAR;
  65.  
  66.  
  67. (* INTERNAL PROCEDURES - NOT IN .def FILE AND NOT IMPORTABLE *)
  68.  
  69.  
  70. PROCEDURE MyOpen(VAR ufn:ARRAY OF CHAR):BOOLEAN;
  71. VAR i:CARDINAL;lk:FileLock;
  72. BEGIN
  73.   linecount := 0;
  74.   Disk := 0;
  75.   Quit := FALSE;
  76.   lk := Lock(ufn,AccessRead);
  77.   IF (lk <> 0) THEN
  78.     Unlock(lk);
  79.     Disk := Open(ufn,ModeOldFile);
  80.   END;
  81.   IF Disk = 0 THEN
  82.     RETURN FALSE
  83.   ELSE
  84.     IF OnScreen THEN
  85.       Concat("RAW:0/0/640/200/Listing of: ",ufn,command);
  86.     ELSE
  87.       command := "PRT:"
  88.     END;
  89.     Display := Open(command,ModeNewFile);
  90.     IF Display = 0 THEN
  91.       Close(Disk);              (* if here - Disk is open *)
  92.       RETURN FALSE
  93.     ELSE
  94.       Quit := FALSE;
  95.       RETURN TRUE
  96.     END
  97.   END
  98. END MyOpen;
  99.  
  100. (* write a string to 'f' - faster than multiple WriteChar's *)
  101.  
  102. PROCEDURE WriteString(f:FileHandle;VAR s:ARRAY OF CHAR);
  103. VAR i:CARDINAL;
  104. BEGIN
  105.   i := 0;
  106.   WHILE (i<=HIGH(s)) AND (s[i]<>0C) DO INC(i) END;
  107.   Result := Write(f,ADR(s),LONGCARD(i));
  108. END WriteString;
  109.  
  110. (* read (with wait) single character from 'f' (here it is keyboard) *)
  111.  
  112. PROCEDURE ReadChar(f:FileHandle;VAR c:CHAR);
  113. BEGIN
  114.   Result := Read(f,ADR(c),1);
  115.   IF Result < 1 THEN c := 0C END
  116. END ReadChar;
  117.  
  118. (* Press Space message and wait for continue-nextline-cancel *)
  119.  
  120. PROCEDURE Pause;
  121. BEGIN
  122.   IF OnScreen THEN
  123.     linecount := 1;
  124.     WriteString(Display,expl);
  125.     KeepWaiting := TRUE;
  126.     REPEAT
  127.       ReadChar(Display,c);
  128.       IF c = CHR(27) THEN
  129.         Quit := TRUE;
  130.       ELSIF c = CHR(13) THEN
  131.         linecount := 21;
  132.       END
  133.     UNTIL (Quit) OR (c = 15C) OR (c = 40C);
  134.     WriteString(Display,wipe);
  135.   END;
  136. END Pause;
  137.  
  138. (* End - press space message & wait for space *)
  139.  
  140. PROCEDURE Finish;
  141.   BEGIN
  142.     IF OnScreen THEN
  143.       WriteString(Display,last);
  144.       REPEAT ReadChar(Display,c) UNTIL (c = 40C);
  145.     END;
  146.   END Finish;
  147.  
  148. (* Closes the disk file and screen (or printer) - NOT DOS Library *)
  149.  
  150. PROCEDURE CloseTheFile;
  151. BEGIN
  152.   IF (Display <> 0) THEN Close(Display) END;
  153.   IF (Disk <> 0) THEN Close(Disk) END;
  154. END CloseTheFile;
  155.  
  156. (* internal procedure for the HexDisplay                                *)
  157. (* Converts a character to a 3 byte (null terminated 3d byte) string    *)
  158. (*  in hex format with leading '0'                                      *)
  159.  
  160. PROCEDURE ToHex(c:CHAR;VAR ch:ARRAY OF CHAR);
  161. VAR v:CARDINAL;
  162. BEGIN
  163.   v := CARDINAL(ORD(c));
  164.   ch[0] := HexCh[v DIV 16];
  165.   ch[1] := HexCh[v MOD 16];
  166.   ch[2] := 0C;
  167. END ToHex;
  168.  
  169. (* kludge to quickly convert a 4 byte (artificial LONGCARD) thingy into
  170.    an increasing file position - used 4 byte since very big files should
  171.    really be taken into account - as if anyone is going to dump a file
  172.    that long - oh, well, it will address it properly if they do         *)
  173.  
  174. PROCEDURE HexAddr(VAR ch:ARRAY OF CHAR);
  175. VAR re:ARRAY[0..2] OF CHAR;
  176. BEGIN
  177.   IF fp1=256 THEN fp1 := 0; INC(fp2) END;       (* with any other       *)
  178.   IF fp2=256 THEN fp2 := 0; INC(fp3) END;       (* necessary movement   *)
  179.   IF fp3=256 THEN fp3 := 0; INC(fp4) END;
  180.   IF fp4=256 THEN fp4 := 0 END;                 (*if THAT big, just roll*)
  181.   ToHex(CHR(fp4),re);
  182.   ch[0] := re[0];ch[1] := re[1];
  183.   ToHex(CHR(fp3),re);
  184.   ch[2] := re[0];ch[3] := re[1];
  185.   ToHex(CHR(fp2),re);
  186.   ch[4] := re[0];ch[5] := re[1];
  187.   ToHex(CHR(fp1),re);
  188.   ch[6] := re[0];ch[7] := re[1];
  189.   INC(fp1,16);
  190. END HexAddr;
  191.  
  192. (* FINALLY THE FIRST IMPORTABLE PROCEDURE       *)
  193. (* SET ToScreen FALSE to go to PRT: device      *)
  194.  
  195. PROCEDURE DisplayASCII(VAR filnam:ARRAY OF CHAR;ToScreen:BOOLEAN);
  196. BEGIN
  197.   OnScreen := ToScreen;
  198.   IF MyOpen(filnam) THEN
  199.     REPEAT
  200.       len := CARDINAL(Read(Disk,ADR(inbuffer),512));
  201.       len2 := 0;
  202.       WHILE (NOT Quit) AND (len2 < len) DO
  203.         i := len2;
  204.         WHILE (i < 511) AND (inbuffer[i] <> 12C) DO INC(i) END;
  205.         Result := Write(Display,ADR(inbuffer[len2]),LONGCARD(i-len2+1));
  206.         len2 := i + 1;
  207.         INC(linecount);
  208.         IF (linecount > 21) AND (inbuffer[i] = 12C) THEN Pause END;
  209.       END;
  210.     UNTIL (len <> 512) OR (Quit);
  211.     Finish;
  212.   END;  (* IF NOT Quit *)
  213.   CloseTheFile;
  214. END DisplayASCII;
  215.  
  216.  
  217. PROCEDURE DisplayHex(VAR filnam:ARRAY OF CHAR;ToScreen:BOOLEAN);
  218. VAR ad:ARRAY[0..7] OF CHAR;
  219. BEGIN
  220.   OnScreen := ToScreen;
  221.   IF MyOpen(filnam) THEN
  222.     fp1:=0;fp2:=0;fp3:=0;fp4:=0;
  223.     REPEAT
  224.       FOR i := 0 TO 70 DO writebuffer[i] := 40C END;
  225.       top := CARDINAL(Read(Disk,ADR(t2),16));
  226.       nextout := 10;
  227.       IF top > 0 THEN
  228.         FOR i := 1 TO top DO
  229.           ToHex(t2[i],ad);
  230.           writebuffer[nextout] := ad[0];
  231.           writebuffer[nextout+1] := ad[1];
  232.           INC(nextout,2);
  233.           IF (i MOD 4)=0 THEN INC(nextout) END;
  234.         END;
  235.         nextout := 48;  (* 39 IF i MOD 8 is left in *)
  236.         FOR i := 1 TO top DO
  237.           IF (t2[i]>177C) OR (t2[i]<40C) THEN
  238.             writebuffer[nextout] := dot
  239.           ELSE
  240.             writebuffer[nextout] := t2[i]
  241.           END;
  242.           INC(nextout);
  243.         END;
  244.         writebuffer[69] := lf;
  245.         writebuffer[70] := 0C;
  246.         HexAddr(ad);
  247.         FOR i := 0 TO 7 DO writebuffer[i] := ad[i] END;
  248.         Result := Write(Display,ADR(writebuffer),70);
  249.         INC(linecount);
  250.         IF (linecount > 21) THEN Pause END;
  251.       END;
  252.     UNTIL (top < 16) OR (Quit);
  253.     Finish
  254.   END;
  255.   CloseTheFile
  256. END DisplayHex;
  257.  
  258.  
  259. (* Initialization items *)
  260.  
  261.  
  262. BEGIN
  263.   IF DOSBase = 0 THEN DOSBase := OpenLibrary(DOSName,0) END;
  264.   IF DOSBase = 0 THEN HALT END; (* WHOOPS!!*)
  265.  
  266.   InitStringModule;
  267.  
  268.   HexCh  := "0123456789ABCDEF";
  269.  
  270. END DuTypefile.
  271.